unit ListPics1;

{
  Demonstration of WebPics CGI program.

  Written by Keith Wood, 12 Aug 1997.
}

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, Db, DBWeb, DBTables;

type
  TwmdListPics = class(TWebModule)
    qryListPics: TQuery;
    wtpListPics: TDataSetTableProducer;
    qryListPicsPICTURE_NO: TIntegerField;
    qryListPicsPICTURE_TEXT: TStringField;
    wppOnePic: TPageProducer;
    qryListPicsPICTURE_TYPE: TStringField;
    wppNotFound: TPageProducer;
    procedure wmdListPicswacListPicsAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure wtpListPicsFormatCell(Sender: TObject; CellRow,
      CellColumn: Integer; var BgColor: THTMLBgColor;
      var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs,
      CellData: String);
    procedure wmdListPicswacOnePicAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure wppOnePicHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure wppNotFoundHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  sYN: array [boolean] of string = ('N', 'Y');
var
  wmdListPics: TwmdListPics;

implementation

{$R *.DFM}

{ Picture list --------------------------------------------------------------- }

{ Generate list of pictures in the database }
procedure TwmdListPics.wmdListPicswacListPicsAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := wtpListPics.Content;
end;

{ Format each description as a link to the picture }
procedure TwmdListPics.wtpListPicsFormatCell(Sender: TObject; CellRow,
  CellColumn: Integer; var BgColor: THTMLBgColor; var Align: THTMLAlign;
  var VAlign: THTMLVAlign; var CustomAttrs, CellData: String);
begin
  if (CellColumn = 0) and (CellRow <> 0) then
    CellData := '<a href="/cgi-bin/listpics.exe/single?id=' +
      qryListPics.FieldByName('PICTURE_NO').AsString + '">' + CellData + '</a>';
end;

{ Single picture ------------------------------------------------------------- }

{ Generate a single picture page }
procedure TwmdListPics.wmdListPicswacOnePicAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  if qryListPics.Locate('PICTURE_NO', Request.QueryFields.Values['ID'], []) then
    Response.Content := wppOnePic.Content
  else
    Response.Content := wppNotFound.Content;
end;

{ Substitute database values into the page }
procedure TwmdListPics.wppOnePicHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  with qryListPics do
    if TagString = 'TEXT' then
      ReplaceText := FieldByName('PICTURE_TEXT').AsString
    else if TagString = 'TYPE' then
      ReplaceText := FieldByName('PICTURE_TYPE').AsString
    else if TagString = 'ID' then
      ReplaceText := FieldByName('PICTURE_NO').AsString
    else if TagString = 'SCRIPT' then
      ReplaceText := Request.ScriptName;
end;

{ Supply error message with incorrect parameters }
procedure TwmdListPics.wppNotFoundHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString = 'SCHEME' then
    ReplaceText := Request.QueryFields.Values['SCHEME']
  else if TagString = 'ID' then
    ReplaceText := Request.QueryFields.Values['ID']
  else if TagString = 'SCRIPT' then
    ReplaceText := Request.ScriptName;
end;

end.